{****************************************************************************
                  Internal Routines called from the Compiler
****************************************************************************}

    { the reverse order of the parameters make code generation easier }
    function fpc_do_is(aclass : tclass;aobject : tobject) : boolean;[public,alias: 'FPC_DO_IS']; compilerproc;
      begin
         fpc_do_is:=assigned(aobject) and assigned(aclass) and
           aobject.inheritsfrom(aclass);
      end;


    { the reverse order of the parameters make code generation easier }
    function fpc_do_as(aclass : tclass;aobject : tobject): tobject;[public,alias: 'FPC_DO_AS']; compilerproc;
      begin
         if assigned(aobject) and not(aobject.inheritsfrom(aclass)) then
           handleerrorframe(219,get_frame);
         result := aobject;
      end;
      
{****************************************************************************
                               TOBJECT
****************************************************************************}
      constructor TObject.Create;
        begin
        end;

      destructor TObject.Destroy;
        begin
        end;

      procedure TObject.Free;

        begin
           // the call via self avoids a warning
           if self<>nil then
             self.destroy;
        end;

      class function TObject.InstanceSize : SizeInt;

        begin
           InstanceSize := PVmt(Self)^.vInstanceSize;
        end;

      var
        emptyintf: ptruint; public name 'FPC_EMPTYINTF';

      {procedure InitInterfacePointers(objclass: tclass;instance : pointer);

        var
          ovmt: PVmt;
          i: longint;
          intftable: pinterfacetable;
          Res: pinterfaceentry;
        begin
          ovmt := PVmt(objclass);
          while assigned(ovmt) and (ovmt^.vIntfTable <> @emptyintf) do
            begin
              intftable:=ovmt^.vIntfTable;
              if assigned(intftable) then
              begin
                i:=intftable^.EntryCount;
                Res:=@intftable^.Entries[0];
                while i>0 do begin
                  if Res^.IType = etStandard then
                    ppointer(@(pbyte(instance)[Res^.IOffset]))^:=
                      pointer(Res^.VTable);
                  inc(Res);
                  dec(i);
                end;
              end;
              ovmt:=ovmt^.vParent;
            end;
        end;}

      class function TObject.InitInstance(instance : pointer) : tobject; {$ifdef SYSTEMINLINE} inline; {$ENDIF}

        begin
           { the size is saved at offset 0 }
           fillchar(instance^, InstanceSize, 0);
           { insert VMT pointer into the new created memory area }
           { (in class methods self contains the VMT!)           }
           ppointer(instance)^:=pointer(self);
           //if PVmt(self)^.vIntfTable <> @emptyintf then
           //  InitInterfacePointers(self,instance);
           InitInstance:=TObject(Instance);
        end;

      class function TObject.ClassParent : tclass;

        begin
           { type of self is class of tobject => it points to the vmt }
           { the parent vmt is saved at offset vmtParent              }
           classparent:=tclass(PVmt(Self)^.vParent);
        end;

      class function TObject.NewInstance : tobject;

        var
           p : pointer;

        begin
           p := getmem(InstanceSize);
           if p <> nil then
              InitInstance(p);
           NewInstance:=TObject(p);
        end;

      procedure TObject.FreeInstance;

        begin
           CleanupInstance;
           FreeMem(Pointer(Self));
        end;

      class function TObject.ClassType : TClass;

        begin
           ClassType:=TClass(Pointer(Self))
        end;

      type
         tmethodnamerec = packed record
            name : pshortstring;
            addr : pointer;
         end;

         tmethodnametable = packed record
           count : dword;
           entries : packed array[0..0] of tmethodnamerec;
         end;

         pmethodnametable =  ^tmethodnametable;

      class function TObject.MethodAddress(const name : shortstring) : pointer;
        begin
           MethodAddress:=nil;
        end;


      class function TObject.MethodName(address : pointer) : shortstring;
        begin
           MethodName:='';
        end;


      function TObject.FieldAddress(const name : shortstring) : pointer;
        begin
           fieldaddress:=nil;
        end;

      function TObject.SafeCallException(exceptobject : tobject;
        exceptaddr : pointer) : longint;

        begin
           safecallexception:=0;
        end;

      class function TObject.ClassInfo : pointer;

        begin
          ClassInfo := PVmt(Self)^.vTypeInfo;
        end;

      class function TObject.ClassName : ShortString;

        begin
          result := '';
        end;

      class function TObject.ClassNameIs(const name : string) : boolean;

        begin
          result := false
        end;

      class function TObject.InheritsFrom(aclass : TClass) : Boolean;

        var
           vmt: PVmt;

        begin
           vmt:=PVmt(self);
           while assigned(vmt) and (vmt <> PVmt(aclass)) do
             vmt := vmt^.vParent;
           InheritsFrom := (vmt = PVmt(aclass));
        end;

      class function TObject.stringmessagetable : pstringmessagetable;

        begin
          stringmessagetable:=PVmt(Self)^.vMsgStrPtr;
        end;

      type
         tmessagehandler = procedure(var msg) of object;


      procedure TObject.Dispatch(var message);
        begin
        end;

      procedure TObject.DispatchStr(var message);
        begin
        end;

      procedure TObject.DefaultHandler(var message);
        begin
        end;

      procedure TObject.DefaultHandlerStr(var message);
        begin
        end;

      function aligntoptr(p : pointer) : pointer;
        begin
      {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
          if (ptrint(p) mod sizeof(ptrint))<>0 then
            inc(ptrint(p),sizeof(ptrint)-ptrint(p) mod sizeof(ptrint));
      {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
          result:=p;
        end;

      procedure TObject.CleanupInstance;

        begin

        end;

      procedure TObject.AfterConstruction;

        begin
        end;

      procedure TObject.BeforeDestruction;

        begin
        end;

      function TObject.getinterface(const iid : tguid;out obj) : boolean;
        begin
          result := false;
        end;

      function TObject.getinterfacebystr(const iidstr : string;out obj) : boolean;
        begin
          result := false;
        end;

      function TObject.getinterface(const iidstr : string;out obj) : boolean;
        begin
          result := false;
        end;

      class function TObject.getinterfaceentry(const iid : tguid) : pinterfaceentry;
        begin
          result := nil;
        end;

      class function TObject.getinterfaceentrybystr(const iidstr : string) : pinterfaceentry;
        begin
          result:=nil;
        end;

      class function TObject.getinterfacetable : pinterfacetable;
        begin
          getinterfacetable:=PVmt(Self)^.vIntfTable;
        end;